home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / os2 / adaptor.zip / ADAPT.ZIP / adaptor / examples / dalib / cshift / all.f next >
Text File  |  1993-06-28  |  3KB  |  130 lines
  1. c      test program for dalib_cshift
  2. c
  3.       program test
  4.       integer N, POS
  5.       parameter (N=15)
  6.       print *, 'Input POS (1-15) '
  7.       read *, POS
  8.       if (POS .ge. 1) then
  9.          call test_shift1a (POS)
  10.          call test_shift1b (POS)
  11.          call test_shift21a (POS)
  12.          call test_shift21b (POS)
  13.          call test_shift22a (POS)
  14.          call test_shift22b (POS)
  15.       end if
  16.       end
  17.  
  18.       subroutine test_shift1a (POS)
  19.       parameter (N=15)
  20.       integer A(N), HA(N), POS
  21.       integer I
  22. cmf$  layout HA(:host)
  23.       forall (I=1:N) A(I) = I
  24.       print *, 'TEST of CSHIFT (A, 1, POS)'
  25.       HA = A
  26.       print 10, HA
  27.       A = cshift (A, 1, POS)
  28.       HA = A
  29.       print 11, HA
  30.   10  format (' A        : ',20I3)
  31.   11  format (' A (shf)  : ',20I3)
  32.       end
  33.  
  34.       subroutine test_shift1b (POS)
  35.       parameter (N=15)
  36.       integer A(N), HA(N), POS
  37.       integer I
  38. cmf$  layout HA(:host)
  39.       forall (I=1:N) A(I) = I
  40.       print *, 'TEST of CSHIFT (A, 1, -POS)'
  41.       HA = A
  42.       print 10, HA
  43.       A = cshift (A, 1, -POS)
  44.       HA = A
  45.       print 11, HA
  46.   10  format (' A        : ',20I3)
  47.   11  format (' A (shf)  : ',20I3)
  48.       end
  49.  
  50.       subroutine test_shift21a (POS)
  51.       parameter (N=15)
  52.       integer A(4, N), HA(4, N), POS
  53.       integer I, J
  54. cmf$  layout HA(:host)
  55.       forall (I=1:N,J=1:4) A(J,I) = I + J
  56.       print *, 'TEST of CSHIFT (A, 1, POS)'
  57.       HA = A
  58.       do J = 1, 4
  59.         print 10, HA(J,:)
  60.       end do
  61.       A = cshift (A, 1, POS)
  62.       HA = A
  63.       do J = 1, 4
  64.         print 11, HA(J,:)
  65.       end do
  66.   10  format (' A        : ',20I3)
  67.   11  format (' A (shf)  : ',20I3)
  68.       end
  69.  
  70.       subroutine test_shift21b (POS)
  71.       parameter (N=15)
  72.       integer A(4, N), HA(4, N), POS
  73.       integer I, J
  74. cmf$  layout HA(:host)
  75.       forall (I=1:N,J=1:4) A(J,I) = I + J
  76.       print *, 'TEST of CSHIFT (A, 1, -POS)'
  77.       HA = A
  78.       do J = 1, 4
  79.         print 10, HA(J,:)
  80.       end do
  81.       A = cshift (A, 1, -POS)
  82.       HA = A
  83.       do J = 1, 4
  84.         print 11, HA(J,:)
  85.       end do
  86.   10  format (' A        : ',20I3)
  87.   11  format (' A (shf)  : ',20I3)
  88.       end
  89.  
  90.       subroutine test_shift22a (POS)
  91.       parameter (N=15)
  92.       integer A(4, N), HA(4, N), POS
  93.       integer I, J
  94. cmf$  layout HA(:host)
  95.       forall (I=1:N,J=1:4) A(J,I) = I + J
  96.       print *, 'TEST of CSHIFT (A, 2, POS)'
  97.       HA = A
  98.       do J = 1, 4
  99.         print 10, HA(J,:)
  100.       end do
  101.       A = cshift (A, 2, POS)
  102.       HA = A
  103.       do J = 1, 4
  104.         print 11, HA(J,:)
  105.       end do
  106.   10  format (' A        : ',20I3)
  107.   11  format (' A (shf)  : ',20I3)
  108.       end
  109.  
  110.       subroutine test_shift22b (POS)
  111.       parameter (N=15)
  112.       integer A(4, N), HA(4, N), POS
  113.       integer I, J
  114. cmf$  layout HA(:host)
  115.       forall (I=1:N,J=1:4) A(J,I) = I + J
  116.       print *, 'TEST of CSHIFT (A, 2, -POS)'
  117.       HA = A
  118.       do J = 1, 4
  119.         print 10, HA(J,:)
  120.       end do
  121.       A = cshift (A, 2, -POS)
  122.       HA = A
  123.       do J = 1, 4
  124.         print 11, HA(J,:)
  125.       end do
  126.   10  format (' A        : ',20I3)
  127.   11  format (' A (shf)  : ',20I3)
  128.       end
  129.  
  130.